home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / PROGRAM / MAKHELP.ARJ / CALC.PAS < prev    next >
Pascal/Delphi Source File  |  1991-07-05  |  3KB  |  144 lines
  1. program calc;
  2. {Copyright (C) 1991 Tansin A. Darcos & Company.  Commercial Rights Reserved.}
  3.  
  4. {Turbo 3
  5. const prefix = #27;              {Code generated on FUNCTION KEY}
  6. {}
  7.  
  8. {Turbo 4+}
  9. USES DOS,CRT;
  10.  const prefix = #0;              {Code generated on FUNCTION KEY}
  11. {}
  12.  
  13. {Note: since you may, from time to time, want to change the help text
  14.        included in the program, you should keep it as an include file
  15.        rather than merging it into the program, but if you're certain
  16.        it won't change, then merge it in. }
  17.  
  18. {$I CALC.INC}   {This file generated by MAKEHELP from CALC.HLP}
  19.  
  20. var a,b,c:real;
  21.     helpstate:integer;
  22.     inhelp:boolean;
  23.     op,
  24.     ch:char;
  25.  
  26. procedure getch; forward;
  27.  
  28. procedure help;
  29. var j,
  30.     x,y:integer;
  31.  
  32. begin
  33.    if not inhelp then
  34.    begin
  35.      x := wherex; y := wherey;
  36.      gotoxy(1,10);
  37.      FOR J := 1 TO Help_Index[helpstate] [2] DO
  38.         WRITELN(Help_Text[Help_Index[helpstate] [1]+(J-1) ]);
  39.      write('Press return to continue ');
  40.      repeat
  41.          inhelp := true;
  42.          getch;
  43.      until ch = #13;
  44.      gotoxy(1,10);
  45.      for J := 1 to Help_Index[helpstate] [2] + 1 DO begin
  46.        clreol; writeln; end;
  47.      gotoxy(x,y);
  48.    end;
  49.    inhelp := false;
  50. end;
  51.  
  52. procedure getch;
  53. var h:integer;
  54.  
  55.    procedure pull;
  56.    begin
  57.    {Turbo 3
  58.         read(kbd,ch);
  59.    {}
  60.    {turbo 4+}
  61.         ch := readkey;
  62.    {}
  63.    end;
  64.  
  65. begin
  66.     while not keypressed do;
  67.     repeat
  68.     pull;
  69.     if (ch = prefix) and keypressed then
  70.       begin
  71.          pull;
  72.          if ch = ';' {F1} then
  73.            begin
  74.               help;
  75.               ch := ' ';
  76.            end
  77.       end;
  78.    until (ch in [#8,#13,'0'..'9','.','*','-','+','/']) ;
  79. end;
  80.  
  81.  
  82. procedure getnum(var r:real);
  83. var  L:string[20];
  84.      I:INTEGER;
  85.  
  86. begin
  87.    ch := ' ';
  88.    l := '';
  89.    repeat
  90.      begin
  91.         getch;
  92.         if ch=#8 then
  93.           begin
  94.              if length(l)>0 then
  95.               begin
  96.                  l[0] := chr(ord(l[0])-1);
  97.                  gotoxy(wherex-1,wherey)
  98.               end
  99.           end
  100.         else
  101.           if ch in ['0'..'9','.'] then
  102.             begin
  103.               l := l+ch;
  104.               write(ch);
  105.             end
  106.       end;
  107.    until (CH=#13) and (L<>'');
  108.    val(L,R,I);
  109.    writeln;
  110. end;
  111.  
  112.  
  113. begin
  114.    clrscr;
  115.    c := 0; a:=0; b:=0;
  116.    gotoxy(1,25);
  117.    write('Press F1 for Help');
  118.    gotoxy(1,3);
  119.    write('Enter first number: ');
  120.    helpstate := 1;
  121.    getnum(a);
  122.    writeln('Enter operation code, * + / or -');
  123.    helpstate := 2;
  124.    repeat
  125.       getch;
  126.    until ch in ['*','+','/','-'];
  127.    op := ch;
  128.    writeln(op);
  129.    writeln('Enter second number: ');
  130.    helpstate := 4;
  131.    getnum(b);
  132.    writeln;
  133.    write('Result of ',a:1:5,' ',op,' ',b:1:5,' is: ');
  134.    case op of
  135.      '*':  c := a*b;
  136.      '-':  c := a-b;
  137.      '+':  c := a+b;
  138.      '/':  if b=0 then
  139.              write(' a divide check, converted to ')
  140.            else
  141.              c := a/b;
  142.     end;
  143.     writeln(c:1:5);
  144.  end.